home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / info-service / gopher / Unix / gateways / gonnrp / gonnrp-2.1 < prev    next >
Encoding:
Text File  |  1993-06-01  |  8.8 KB  |  330 lines
  1. #!/bin/perl 
  2. # Gopher-nnrp Gateway version 2.0  mojor rewrite by: Chad Adams
  3. # 28-May-1993 version 2.1 Chad Adams (c-adams@bgu.edu)
  4. # build in access control for clari groups.  Make errors returned the same
  5. #   format as server errors so our version of gopher will put them in pop
  6. #   up box.
  7. #
  8. # 28-May-1993 version 2.0 Chad Adams (c-adams@bgu.edu)
  9. # add newgroups database.
  10. # add multi level newsgroup menus.  [each .part. of newsgroup automaticly
  11. #   gets it's own menu instead of putting all (like all of comp) in one
  12. #   menu.  {now menus like comp.sys, comp.lang, comp.sources, ect..}]
  13. # convert to use xhdr instead of tin's xindex.  If not used with INN using
  14. #   overview files to speed up xhdr it may be slow.
  15. #
  16. # Gopher-NNTP Gateway version 1.0
  17. # Author: Daniel Schales (dan@engr.latech.edu)
  18. # Major rewrite, socket support: Doug Schales (d1s8027@sc.tamu.edu)
  19. #
  20. # Set the 4 following variables for your setup. the 2 port variables
  21. # are set to the standard, be sure to set gopherhost and nntphost to
  22. # your respective hosts.
  23. $gopherhost="your.host.here";
  24. $gopherport=2008;
  25. $nntphost="your.host.here";
  26. $nntpprt='nntp';
  27.  
  28. # localaddr for clari access.  Example:
  29. # @localaddr(143, 43, 139, 67);
  30. # allows access to 143.43.*.* and 139.67.*.*
  31. @localaddr = (143, 43, 139, 67);
  32.  
  33. @INC=("/usr/local/lib/perl");
  34. require 'sys/socket.ph';
  35. dump QUICKSTART if @ARGV[0] eq '-dump';
  36. QUICKSTART:
  37.  
  38. $SIG{'ALRM'} = 'stuck';
  39. $option=shift;
  40. $option = '-h' if $option eq '-t';
  41. while ($option eq '-f') {
  42.       $copyright = shift;
  43.       $option = shift;
  44.       open(CR, $copyright);
  45.       $title = <CR>;
  46.       close(CR);
  47.       chop($title);
  48.       print "0$title\t$copyright\t$gopherhost\t$gopherport\r\n";
  49. }
  50. $item=shift;
  51. if ($option eq '-X') {
  52.     @arts = @ARGV;
  53. } else {
  54.     $lookup=shift;
  55. }
  56. if (-S STDIN && ($item =~ m/^clari/)) {
  57.     $sockaddr = 'S n a4 x8';
  58.     ($fam, $proto, $addr) = unpack($sockaddr,getpeername(STDIN));
  59.     @inetaddr = unpack('C4',$addr);
  60.     for ($i = 0; $i < $#localaddr; $i += 2) {
  61.         $validaccess = 1 if @localaddr[$i] == @inetaddr[0] &&
  62.             @localaddr[$i+1] == @inetaddr[1];
  63.     }
  64.     $_ = 'Off site access not allowed to clari newsgroups  ';
  65.     &checkcode($validaccess,1);
  66. }
  67.  
  68. # set an alarm 5 minutes from now, if it goes off we must be stuck
  69. alarm(300);
  70. open(LOG,">>/tmp/nntplog");
  71. $date=`date`;chop($date);
  72. print LOG $date," ",$option," ",$item," ",$lookup,"\n";
  73. close(LOG);
  74. $sockaddr = 'S n a4 x8';
  75. ($name, $aliases, $proto) = getprotobyname('tcp');
  76. ($name, $aliases, $nntpport) = getservbyname($nntpprt, 'tcp');
  77. ($name, $aliases, $type, $len, $nntpaddr) = gethostbyname($nntphost);
  78.  
  79. $rsockaddr = pack($sockaddr, &AF_INET, $nntpport, $nntpaddr);
  80.  
  81. socket(NNTPSOCK, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  82. connect(NNTPSOCK, $rsockaddr) || die "connect: $!";
  83.  
  84. select(NNTPSOCK); $|= 1; select(stdout);
  85.  
  86. $_ = <NNTPSOCK>;
  87.  
  88. if ($option eq '-g') {
  89.     dbmopen(newsgroups, '/usr/lib/newsgroups', 0444);
  90.     print NNTPSOCK "LIST\n";
  91.     $_ = <NNTPSOCK>;
  92.     chop; chop;
  93.     while($_ ne "."){
  94.     if($_ =~ "^$item"){
  95.         ($group) = split;
  96.         push(@out,"1$group - $newsgroups{$group}\texec:-h $group:".
  97.             "/bin/gonnrp\t$gopherhost\t$gopherport\r\n");
  98.     }
  99.     $_ = <NNTPSOCK>;
  100.     chop; chop;
  101.     }
  102.     print sort(@out);
  103.     print ".\r\n";
  104. } elsif ($option eq '-G') {
  105.     dbmopen(newsgroups, '/usr/lib/newsgroups', 0444);
  106.     print NNTPSOCK "LIST\n";
  107.     $_ = <NNTPSOCK>;
  108.     chop; chop;
  109.     $itemlen = length($item) + 1;
  110.     @grouplist = ();
  111.     while($_ ne "."){
  112.     if($_ =~ "^$item"){
  113.             ($group) = split;
  114.         push(@grouplist, $group);
  115.     }
  116.         $_ = <NNTPSOCK>;
  117.         chop; chop;
  118.     }
  119.     @grouplist = sort(@grouplist);
  120.     for ($i = 0; $i <= $#grouplist; $i++) {
  121.         $group = @grouplist[$i];
  122.         if ($group eq $item) {
  123.         $grp = $group;
  124.             print "1$newsgroups{$group}\texec:-T $group:".
  125.             "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  126.         } else {
  127.         $grp = substr($group,$itemlen,40);
  128.         if (index($grp,'.') != -1) {
  129.             @grppart = split(/\./,$grp);
  130.             if (@grppart[0] eq $oldgrp) {
  131.             next;
  132.             }
  133.             $oldgrp = @grppart[0];
  134.             $grp = @grppart[0];
  135.                 print "1$grp - ".$newsgroups{"$item.$grp.all"}.
  136.             "\texec:-G $item.$grp".
  137.             ":/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  138.         } else {
  139.             if ($group eq substr(@grouplist[$i+1],0,length($group))) {
  140.                     print "1$grp - ".$newsgroups{"$item.$grp.all"}.
  141.                 "\texec:-G $group:".
  142.                 "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  143.             $oldgrp = $grp;
  144.             } else {
  145.                     print "1$grp - $newsgroups{$group}\texec:-T $group:".
  146.                 "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  147.             }
  148.         }
  149.         }
  150.     }
  151.     print ".\r\n";
  152. } elsif($option eq '-X') {
  153. #    $item = newsgroup
  154. #    @arts = articles in this thread
  155. #      or
  156. #    @arts = 0 low high  if list would be too long
  157.     ($code) = &group($item);
  158.     # build arts array if we were passed range
  159.     @arts = split(' ', &buildidx(@arts[1], @arts[2])) if @arts[0] == 0;
  160.     foreach $art (@arts) { $goodart{$art} = 1; }
  161.     &xhdr('from', @arts[0], @arts[$#arts]);
  162.     while (<NNTPSOCK>) {
  163.         last if substr($_,0,1) eq '.';
  164.         chop; chop;
  165.         ($art, $from) = split(/ /,$_,2);
  166.         print "0$from\texec:-a ${item} $art:/bin/gonnrp\t".
  167.             "$gopherhost\t$gopherport\r\n" if $goodart{$art};
  168.     }
  169.     print ".\r\n";
  170. } elsif($option eq '-T') {
  171.     ($code, $cnt, $low, $high) = &group($item);
  172.     &buildidx($low, $high);
  173.     @keys = sort(keys %idx);
  174.     foreach $key (@keys) {
  175.         @arts = split(' ',$idx{$key});
  176.         if ($#arts == 0) { # single article
  177.             print "0$key\texec:-a ${item} @arts[0]:".
  178.               "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  179.         } else { # thread
  180.             if (length($idx{$key}) < 80) { # send article list
  181.                 print "1$key\texec:-X $item$idx{$key}:".
  182.                   "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  183.             } else { # give range
  184.                 print "1$key\texec:".
  185.                   "-X $item 0 @arts[0] @arts[$#arts]:".
  186.                   "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  187.             }
  188.         }
  189.     }
  190.     print ".\r\n";
  191. } elsif($option eq '-l'){
  192.     ($code, $count, $start, $end) = &group($item);
  193.     if($count ne "0"){
  194.         print NNTPSOCK "ARTICLE $end\n";
  195.         $body=0;
  196.         $_ = <NNTPSOCK>;
  197.         chop; chop;
  198.         while($_ ne "."){
  199.             if ($body) {
  200.                 print "$_\r\n";
  201.             } elsif ($_ =~ "^220 " || $_ =~ "^222 ") {
  202.                 $body = 1;
  203.             }
  204.         }
  205.              $_ = <NNTPSOCK>;
  206.              chop; chop;
  207.      }
  208. }
  209. # rwp 20Aug92 Add ability to fetch last article.
  210.  
  211. elsif($option eq '-h' || $option eq '-b' || $option eq '-s'){
  212.     ($code, $count, $start, $end) = &group($item);
  213.     if($count ne "0"){
  214.         &xhdr('subject', $start, $end);
  215.         $_ = <NNTPSOCK>;
  216.         chop; chop;
  217.         while($_ ne '.'){
  218.             ($num,$desc) = split (/ /,$_,2);
  219.             if ($option eq '-h' ) {
  220.                 print "0$desc\texec:-a ${item} ${num}:".
  221.                   "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  222.             } elsif ($option eq '-b') {
  223.                 print "0$desc\texec:-a ${item} ${num} body".
  224.                   ":/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  225.             } elsif ($option eq '-s') {
  226.                 $desc1="\L$desc\E";
  227.                 $lookup1 ="\L$lookup\E";
  228.                 if ($desc1 =~ $lookup1 ) {
  229.                  print "0$desc\texec:-a ${item} ${num}:".
  230.                   "/bin/gonnrp\t$gopherhost\t$gopherport\t\r\n";
  231.                 }
  232.             }
  233.             $_ = <NNTPSOCK>;
  234.             chop; chop;
  235.         }
  236.     }
  237.     print ".\r\n";
  238. } elsif($option eq '-a'){
  239.     $num = $lookup;
  240.     $part = shift;
  241.     ($code) = &group($item);
  242.     if($part eq "body") {
  243.         print NNTPSOCK "BODY $num\n";
  244.         ($code) = split(/ /,($_ = <NNTPSOCK>));
  245.         &checkcode($code,222);
  246.     } else {
  247.         print NNTPSOCK "ARTICLE $num\n";
  248.         ($code) = split(/ /,($_ = <NNTPSOCK>));
  249.         &checkcode($code,220);
  250.     }
  251.     $_ = <NNTPSOCK>;
  252.     chop; chop;
  253.     while($_ ne "."){
  254.         print "$_\r\n";
  255.         $_ = <NNTPSOCK>;
  256.         chop; chop;
  257.     }
  258. }
  259.  
  260. print NNTPSOCK "QUIT\n";
  261. shutdown(NNTPSOCK, 2);
  262. exit(0);
  263.  
  264. sub stuck {
  265. open(LOG,">>/tmp/nntplog");
  266. $date=`date`;chop($date);
  267. print LOG $date," hung on ",$option," ",$item," ",$lookup,"\n";
  268. close(LOG);
  269.  
  270. exit;
  271. }
  272.  
  273. # Chad Adams  28-May-1993  tin's xindex to xhdr conversion
  274. sub checkcode { # return error when nntp command failes
  275.     local($code, $goodcode) = @_;
  276.     if ($code != $goodcode) {
  277.         chop; chop;
  278.         print "0nnrp error: $_\t\terror.host\t1\r\n";
  279.         print ".\r\n";
  280.         exit;
  281.     }
  282. }
  283. sub buildidx {    # build subject threads
  284.     local ($low, $high) = @_;
  285.     local ($first, $fsubj, $re, $subj);
  286.     $first = 1;
  287.     &xhdr('subject', $low, $high);
  288.     $cnt = 0;
  289.     while (<NNTPSOCK>) {
  290.         last if substr($_,0,1) eq '.';
  291.         chop; chop;
  292.         ($art, $subj) = split(/ /,$_,2);
  293.         while (1) { # remove Re:
  294.             $re = substr($subj,0,2);
  295.             $re =~ tr/A-Z/a-z/;
  296.             if ($re eq 're') {
  297.                 $subj = substr($subj,2);
  298.                 next;
  299.             } elsif (substr($subj,0,1) eq ':') {
  300.                 $subj = substr($subj,1);
  301.                 next;
  302.             } elsif (substr($subj,0,1) eq ' ') {
  303.                 $subj = substr($subj,1);
  304.                 next;
  305.             }
  306.             last;
  307.         }
  308.         if ($first) {
  309.             $fsubj = $subj;
  310.             $first = 0;
  311.         }
  312.         $idx{$subj} .= " $art";
  313.         $cnt++;
  314.     }
  315.     return $idx{$fsubj};
  316. }
  317. sub group { # (code, count, low, high) = &group(newsgroup)
  318.     local(@rtn);
  319.     print NNTPSOCK "group @_[0]\n";
  320.     @rtn = split(/ /,($_ = <NNTPSOCK>), 5);
  321.     &checkcode(@rtn[0],211);
  322.     return @rtn;
  323. }
  324. sub xhdr { # &xhdr(header,low,high)
  325.     local($code);
  326.     print NNTPSOCK "xhdr @_[0] ".@_[1].'-'.@_[2]."\n";
  327.     ($code) = split(/ /,($_ = <NNTPSOCK>));
  328.     &checkcode($code,221);
  329. }
  330.